home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / transcript.t < prev    next >
Encoding:
Text File  |  1988-05-02  |  3.1 KB  |  75 lines
  1. (herald transcript (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;; Transcript facility.
  27.  
  28. ;++ This should be moved to the libraries section of the manual.
  29.  
  30. (lset +transcript+ nil)
  31. (lset +standard-output+ nil)
  32. (lset +input-underflow+ nil)
  33.  
  34. (define (transcript-on filename)
  35.   (cond (+transcript+
  36.          (format (standard-output)
  37.                  ";Transcript file ~a is already open.~%"
  38.                  (port-name +transcript+))
  39.          nil)
  40.         (else
  41.          (set +transcript+ (open filename 'out))
  42.          (format +transcript+ ";;; T transcript file ~a~%~%" filename)
  43.          (set +input-underflow+ (iob-underflow (standard-input)))
  44.          (set (iob-underflow (standard-input))
  45.               (make-echo-underflow +transcript+))
  46.          (set +standard-output+ (standard-output))
  47.          (let ((b (make-broadcast-port (standard-output) +transcript+)))
  48.            ;++ what a crock
  49.            (set (standard-output) b)
  50.            (set (terminal-output) b)
  51.            (set (repl-output) b))
  52.          'ok)))
  53.  
  54. (define (transcript-off)
  55.   (cond (+transcript+
  56.          (set (standard-output) +standard-output+)
  57.          (set (terminal-output) +standard-output+)
  58.          (set (repl-output) +standard-output+)
  59.          (set (iob-underflow (standard-input)) +input-underflow+)
  60.          (format +transcript+ "~&~%;;; End of transcript file~%")
  61.          (close +transcript+)
  62.          (set +transcript+ nil)
  63.          (set +input-underflow+ nil)
  64.          (set +standard-output+ nil)
  65.          'ok)
  66.         (else nil)))
  67.  
  68. (define (make-echo-underflow out-iob)
  69.   (lambda (in-iob block?)
  70.     (let ((cnt (%vm-read-buffer in-iob block?))
  71.           (buf (iob-buffer in-iob)))
  72.       (do ((i 0 (fx+ i 1)))
  73.           ((fx>= i cnt))
  74.         (vm-write-char out-iob (text-elt buf i))))))
  75.